home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / CMPLTPAS / LOCATE.PAS < prev    next >
Pascal/Delphi Source File  |  1988-07-13  |  9KB  |  235 lines
  1. {--------------------------------------------------------------}
  2. {                           LOCATE                             }
  3. {                                                              }
  4. {            Disk file tree-search search utility              }
  5. {                                                              }
  6. {                             by Jeff Duntemann                }
  7. {                             Turbo Pascal V5.0                }
  8. {                             Last update 5/22/88              }
  9. {                                                              }
  10. { This utility searches a tree of directories (from the root   }
  11. { or from any child directory of the root) for a given file    }
  12. { spec, either unique or ambiguous.  It provides a good        }
  13. { example of the use of the DOS 2.X/3.X FIND FIRST/NEXT        }
  14. { function calls.  See the main program block for instructions }
  15. { on its use.                                                  }
  16. {                                                              }
  17. {      From: COMPLETE TURBO PASCAL 5.0  by Jeff Duntemann      }
  18. {    Scott, Foresman & Co., Inc. 1988   ISBN 0-673-38355-5     }
  19. {--------------------------------------------------------------}
  20.  
  21. PROGRAM Locate;
  22.  
  23. USES DOS;
  24.  
  25. TYPE
  26.   String80 = String[80];
  27.   String15 = String[15];
  28.  
  29. {$I TIMEREC.DEF}   { Described in Section 20.6 }
  30. {$I DATEREC.DEF}   { Described in Section 20.6 }
  31. {$I DIRREC.DEF}    { Described in Section 20.7 }
  32.  
  33.   DTAPtr  = ^SearchRec;
  34.  
  35.  
  36. VAR
  37.   I,J              : Integer;
  38.   SearchSpec       : String80;
  39.   InitialDirectory : String80;
  40.   Searchbuffer     : SearchRec;
  41.  
  42.  
  43. {$I DAYOWEEK.SRC}  { Described in Section 20.6 }
  44. {$I CALCDATE.SRC}  { Described in Section 20.6 }
  45. {$I CALCTIME.SRC}  { Described in Section 20.6 }
  46. {$I DIRSTRIN.SRC}  { Described in Section 20.7 }
  47. {$I DTATODIR.SRC}  { Described in Section 20.7 }
  48.  
  49.  
  50. {->>>>SearchDirectory<<<<--------------------------------------}
  51. {                                                              }
  52. { This is the real meat of program LOCATE.  The machinery      }
  53. { for using FIND FIRST and FIND NEXT are placed in a procedure }
  54. { so that it may be recursively called.  Recursion is used     }
  55. { because it is the most elegant way to search a tree, which   }
  56. { is really all we're doing here.  All the messiness (and it   }
  57. { IS messy!) exists to cater to DOS's peculiarities.           }
  58. {                                                              }
  59. { For example, note that each recursive instantiation of       }
  60. { SearchDirectory needs its own DTA.  No problem--one is       }
  61. { created on the stack each time SearchDirectory is called.    }
  62. { BUT--DOS is not a party to the recursion, so the DTA address }
  63. { must be set both before AND after the recursive call, so     }
  64. { that once control comes BACK to an instance of               }
  65. { SearchDirectory that has been left via recursion, DOS can    }
  66. { "come back" to the temporarily dormant DTA, which may still  }
  67. { contain information necessary to execute a FIND NEXT call.   }
  68. {                                                              }
  69. { Much of the rest of the fooling around involves formatting   }
  70. { the search strings correctly for passing to the next         }
  71. { instantiation of SearchDirectory.                            }
  72. {                                                              }
  73. { It's not documented, but I have found that DOS returns error }
  74. { code 3 (Bad Path) on a file FIND when the path includes a    }
  75. { nonexistant directory name.  Error code 2, on the other      }
  76. { hand, while documented, never seems to come up at all.       }
  77. {--------------------------------------------------------------}
  78.  
  79.  
  80. PROCEDURE SearchDirectory(Directory,SearchSpec : String);
  81.  
  82. VAR
  83.   NextDirectory : String;
  84.   TempDirectory : String;
  85.   CurrentDTA    : SearchRec;
  86.   CurrentDIR    : DIRRec;
  87.   Regs          : Registers;
  88.  
  89.  
  90. {>>>>DisplayData<<<<}
  91. { Displays file data and full path for the passed file }
  92.  
  93. PROCEDURE DisplayData(Directory : String; CurrentDIR : DIRRec);
  94.  
  95. VAR
  96.   Temp : String;
  97.  
  98. BEGIN
  99.   Temp := DIRToString(CurrentDIR);
  100.   Delete(Temp,1,13);
  101.   Write(Temp,Directory);
  102.   IF Directory <> '\' THEN Write('\');
  103.   Writeln(CurrentDIR.FileName);
  104. END;
  105.  
  106.  
  107.  
  108. BEGIN
  109.   { First we look for any subdirectories.  If any are found, }
  110.   { we make a recursive call and search 'em too: }
  111.  
  112.   { Suppress unnecessary backslashes if we're searching the root: }
  113.   IF Directory = '\' THEN
  114.     TempDirectory := Directory + '*.*'
  115.   ELSE
  116.     TempDirectory := Directory + '\*.*';
  117.  
  118.   { Now make the FIND FIRST call for directories: }
  119.  
  120.   FindFirst(TempDirectory,$10,CurrentDTA);
  121.  
  122.  
  123.   { Here's the tricky stuff.  If we get an indication that there is }
  124.   { at least one more subdirectory within the current directory,    }
  125.   { (indicated by lack of error codes 2 or 18) we must search it    }
  126.   { by making a recursive call to SearchDirectory.  We continue     }
  127.   { recursing and returning from the searched subdirectories until  }
  128.   { we get a code indicating none are left. }
  129.   WHILE (DOSError <> 2) AND (DOSError <> 18) DO
  130.     BEGIN
  131.       IF  ((CurrentDTA.Attr AND $10) = $10)   { If it's a directory }
  132.       AND (CurrentDTA.Name[1] <> '.') THEN  { and not '.' or '..' }
  133.         BEGIN
  134.           { Add a slash separating sections of the path if we're not }
  135.           { currently searching the root: }
  136.           IF Directory <> '\' THEN NextDirectory := Directory + '\'
  137.             ELSE NextDirectory := Directory;
  138.  
  139.           { This begins with the current directory name, and copies }
  140.           { the name of the found directory from the current DTA to }
  141.           { the end of the current directory string.  Then the new  }
  142.           { path is passed to the next recursive instantiation of   }
  143.           { SearchDirectory. }
  144.           NextDirectory := NextDirectory + CurrentDTA.Name;
  145.  
  146.           { Here's where we call "ourselves." }
  147.           SearchDirectory(NextDirectory,SearchSpec);
  148.  
  149.         END;
  150.        FindNext(CurrentDTA);  { Now we look for more... }
  151.     END;
  152.  
  153.   { Now we can search for files, once we've run out of directories.  }
  154.   { This is conceptually simpler, as recursion is not involved.      }
  155.   { We combine the path and the file spec into one string, and make  }
  156.   { the FIND FIRST call: }
  157.  
  158.   { Suppress unnecessary slashes for root search: }
  159.   IF Directory <> '\' THEN
  160.     TempDirectory := Directory + '\' + SearchSpec
  161.   ELSE TempDirectory := Directory + SearchSpec;
  162.  
  163.   { Now, make the FIND FIRST call: }
  164.   FindFirst(TempDirectory,$07,CurrentDTA);
  165.  
  166.   IF DOSError = 3 THEN       { Bad path error }
  167.     Writeln('Path not found; check spelling.')
  168.  
  169.   { If we found something in the current directory matching the filespec, }
  170.   { format it nicely into a single string and display it: }
  171.   ELSE IF (DOSError = 2) OR (DOSError = 18) THEN
  172.     { Null; Directory is empty }
  173.   ELSE
  174.     BEGIN
  175.       DTAtoDIR(CurrentDIR);      { Convert first find to DIR format.. }
  176.       DisplayData(Directory,CurrentDIR);        { Show it pretty-like }
  177.  
  178.       IF DOSError <> 18 THEN { More files are out there... }
  179.         REPEAT
  180.           FindNext(CurrentDTA);
  181.           IF DOSError <> 18 THEN  { More entries exist }
  182.             BEGIN
  183.               DTAtoDIR(CurrentDIR); { Convert further finds to DIR format }
  184.               DisplayData(Directory,CurrentDIR)         { and display 'em }
  185.             END
  186.         UNTIL (DOSError = 18) OR (DOSError = 2)  { Ain't no more! }
  187.     END
  188. END;
  189.  
  190.  
  191. BEGIN
  192.   IF ParamCount = 0 THEN
  193.     BEGIN
  194.       Writeln('>>LOCATE<<  V2.00  By Jeff Duntemann');
  195.       Writeln('            From the book, COMPLETE TURBO PASCAL 5.0');
  196.       Writeln('            Scott, Foresman & Co. 1988');
  197.       Writeln('            ISBN 0-673-38355-5');
  198.       Writeln;
  199.       Writeln('This program searches for all files matching a given ');
  200.       Writeln('filespec on the current disk device, in any subdirectory.');
  201.       Writeln('Now that 32MB disks are getting cheap, we can pile up');
  202.       Writeln('great heaps of files and easily forget where we put things.');
  203.       Writeln('Given only the filespec, LOCATE prints out the FULL PATH');
  204.       Writeln('of any file matching that filespec.');
  205.       Writeln;
  206.       Writeln('CALLING SYNTAX:');
  207.       Writeln;
  208.       Writeln('LOCATE <filespec>');
  209.       Writeln;
  210.       Writeln('For example, to find out where your screen capture files');
  211.       Writeln('(ending in .CAP) are, you would enter:');
  212.       Writeln;
  213.       Writeln('LOCATE *.CAP');
  214.       Writeln;
  215.       Writeln('and LOCATE will show the pathname of any file ending in .CAP.');
  216.     END
  217.   ELSE
  218.     BEGIN
  219.       Writeln;
  220.       SearchSpec := ParamStr(1);
  221.       { A "naked" filespec searches the entire volume: }
  222.       IF Pos('\',SearchSpec) = 0 THEN
  223.         SearchDirectory('\',SearchSpec)
  224.       ELSE
  225.         BEGIN
  226.           { This rigamarole separates the filespec from the path: }
  227.           I := Length(SearchSpec);
  228.           WHILE SearchSpec[I] <> '\' DO I := Pred(I);
  229.           InitialDirectory := Copy(SearchSpec,1,I-1);
  230.           Delete(SearchSpec,1,I);
  231.           SearchDirectory(InitialDirectory,SearchSpec);
  232.         END;
  233.     END
  234. END.
  235.